Option Explicit On 

Public Class URLFunctions
   'Module Functions

   Shared Function GetAbsoluteLink(ByVal URL As String, ByVal LinkURL As String) As String
      ' Out: Normalized URL

      ' Normalise URL
      URL = Normalise(URL)

      Dim Result

      If InStr(LinkURL, ":") > 0 And (InStr(LinkURL, ":") < InStr(LinkURL, "/") Or InStr(LinkURL, "/") = 0) Then
         ' Link with protocol (e.g. mailto: or http://
         Result = LinkURL
      ElseIf Left(LinkURL, 1) = "#" Then
         ' Anchor link
         Result = URL & LinkURL
      ElseIf InStr(LinkURL, "/") = 0 Then
         ' Simple page link
         Result = GetAbsoluteFolder(URL) & LinkURL
      ElseIf Left(LinkURL, 1) = "/" Then
         ' Simple absolute path
         Result = GetRoot(URL) & Mid(LinkURL, 2)
      ElseIf InStr(LinkURL, "../") = 0 Then
         ' Simple relative path
         Result = GetAbsoluteFolder(URL) & LinkURL
      ElseIf Left(LinkURL, 3) = "../" Then
         ' Parent paths
         Result = Complex2Simple(URL, LinkURL)
      Else
         'dpe("Error parsing URL: " & URL)
      End If


      Return Normalise(Result)

   End Function

   Shared Function Complex2Simple(ByVal URL As String, ByVal LinkURL As String) As String

      Dim u
      u = GetRelativeStem(GetAbsoluteFolder(URL))
      u = Left(u, Len(u) - 1)
      Dim l
      l = LinkURL
      Do While InStr(l, "../") > 0
         l = Mid(l, InStr(l, "../") + 3)
         If InStrRev(u, "/") Then u = Left(u, InStrRev(u, "/") - 1)
      Loop
      URL = GetRoot(URL)
      Return Left(URL, Len(URL) - 1) & u & "/" & l

   End Function

   Shared Function GetAbsoluteFolder(ByVal URL As String) As String
      ' Out: Normalized URL

      URL = Normalise(URL)
      URL = GetStem(URL)
      Return Left(URL, InStrRev(URL, "/"))

   End Function

   Shared Function GetRoot(ByVal URL As String) As String

      ' Remove querystring
      URL = GetStem(URL)

      ' Get Protocol
      Dim protocol As String
      protocol = GetProtocol(URL)

      If protocol <> "" Then
         If InStr(Len(protocol) + 4, URL, "/") > 0 Then
            Return Left(URL, InStr(Len(protocol) + 4, URL, "/"))
         Else
            Return URL & "/"
         End If
      Else
         Return ""
      End If

   End Function

   Shared Function GetDomain(ByVal URL As String) As String

      ' Get Root URL
      URL = GetRoot(URL)
      ' Remove protocol and "://"
      URL = Mid(URL, Len(GetProtocol(URL)) + 4)
      ' Remove port
      If InStr(URL, ":") Then URL = Left(URL, InStr(URL, ":") - 1)
      ' Remove path
      If InStr(URL, "/") Then URL = Left(URL, InStr(URL, "/") - 1)

      Return URL

   End Function

   Shared Function GetProtocol(ByVal URL As String) As String

      Dim t1, t2
      ' Assume protocol name is less than 10 characters
      t1 = InStr(Left(URL, 10), ":")
      t2 = InStr(URL, "/")
      If t1 > 1 And t2 > t1 Then
         Return Left(URL, t1 - 1)
      Else
         Return ""
      End If

   End Function

   Shared Function IsValid(ByVal URL As String) As Boolean

      ' Must have a protocol
      If GetProtocol(URL) = "" Then Return False
      ' Must have ://
      If InStr(URL, "://") <> Len(GetProtocol(URL)) + 1 Then Return False
      ' Must have a domain
      If GetDomain(URL) = "" Then
         Return False
      Else
         Return True
      End If

   End Function

   Shared Function Normalise(ByVal URL As String) As String

      If URL = "" Then Return ""

      Dim NURL
      NURL = URL

      If InStr(NURL, "#") > 0 Then
         ' Remove anchors
         NURL = Left(NURL, InStr(NURL, "#") - 1)
      End If

      If Right(NURL, 1) = "?" Then
         ' Empty Query String
         NURL = Left(NURL, Len(NURL) - 1)
      End If

      Dim Stem
      Stem = GetStem(NURL)

      If Right(Stem, 1) <> "/" And InStr(GetRelativeStem(Stem), ".") = 0 And GetRelativeStem(Stem) <> "" Then
         ' Path URL without slash
         Stem = Stem & "/"
      End If

      If InStr(NURL, "?") Then
         NURL = Stem & "?" & GetQueryString(NURL)
      Else
         NURL = Stem
      End If

      If NURL <> "" Then
         Do While InStr(NURL, "&&")
            NURL = Replace(NURL, "&&", "&")
         Loop
         NURL = Replace(NURL, "?&", "?")
      End If

      Return NURL

   End Function

   Shared Function GetStem(ByVal URL As String) As String

      If InStr(URL, "?") Then
         GetStem = Left(URL, InStr(URL, "?") - 1)
      Else
         Return URL
      End If

   End Function

   Shared Function GetQueryString(ByVal URL As String) As String

      If InStr(URL, "?") > 0 Then
         Return Mid(URL, InStr(URL, "?") + 1)
      Else
         Return ""
      End If

   End Function

   Shared Function GetRelativeStem(ByVal URL As String) As String

      ' Get root URL
      Dim root
      root = GetRoot(URL)

      ' Get stem only (no query string)
      Dim stem
      stem = GetStem(URL)

      ' Remove root to reveal relative stem
      If Len(root) > 0 Then stem = Mid(stem, Len(root))

      Return stem

   End Function

   Shared Function GetRelative(ByVal URL As String) As String

      ' Get root URL
      Dim root
      root = GetRoot(URL)

      If Len(root) > 0 Then
         Return Mid(URL, Len(root))
      Else
         Return URL
      End If

   End Function

   Shared Function GetFilename(ByVal URL As String) As String
      ' In: Normalised URL

      ' Relative stem
      URL = GetRelativeStem(URL)

      If InStrRev(URL, "/") <> Len(URL) Then
         Return Mid(URL, InStrRev(URL, "/") + 1)
      Else
         Return ""
      End If

   End Function

   Shared Function GetExtension(ByVal URL As String) As String

      ' Relative stem
      URL = GetRelativeStem(URL)

      If (InStrRev(URL, ".") > InStrRev(URL, "/")) Or (InStrRev(URL, "/") = 0 And InStrRev(URL, ".") > 0) Then
         Return Mid(URL, InStrRev(URL, ".") + 1)
      Else
         Return ""
      End If

   End Function


   Shared Function DecodeHTMLURL(ByVal URL As String) As String

      If URL = "" Then Return ""

      ' Replace special characters
      URL = Replace(URL, "&amp;", "&")

      Return URL

   End Function

   Shared Function Decode(ByVal URL As String) As String

      Dim temp, pos
      temp = URL
      pos = InStr(1, temp, "%")
      Do While pos > 0
         temp = Left(temp, pos - 1) + _
          Chr(CLng("&H" & Mid(temp, pos + 1, 2))) + _
          Mid(temp, pos + 3)
         pos = InStr(pos + 1, temp, "%")
      Loop

      Return temp

   End Function

End Class